DATA_array <- array(NA, dim= c(dim(DATA), length(P$var_names)))
for(i in 1:length(P$var_names))
{
DATA <- read.xlsx2(P$var_data_file, sheetName = P$var_names[i], header = T)
DATA <- apply(DATA[,-1], 2, as.numeric)
DATA_array[,,i] <- DATA
}
matching_start_id <- which(Dates_all ==P$matching_start_date)
matching_end_id   <- which(Dates_all ==P$matching_end_date)
result <- prepare_arrays(DATA_array, matching_start_id, matching_end_id, P)
DATA_donor          <- result$DATA_donor
DATA_donor_matching <- result$DATA_donor_matching
DATA_array_matching <- result$DATA_array_matching
X_matrix           <- apply(DATA_donor, 2, c)
X_matrix_matching  <- apply(DATA_donor_matching, 2, c)
if (P$use_intercep_for_w)
{
dummies_for_intercept          <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor)[1],1))
dummies_for_intercept_matching <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor_matching)[1],1))
X_matrix                   <- cbind(dummies_for_intercept, X_matrix)
X_matrix_matching          <- cbind(dummies_for_intercept_matching, X_matrix_matching)
}
F_factors          <- return_factors(DATA_donor, P)
F_matrix           <- regression_matrix_for_F(F_factors, P)
F_matrix_matching  <- regression_matrix_for_F(F_factors[matching_start_id:matching_end_id,], P)
F_coeff_matrix <-  matrix(NA, dim(F_matrix)[2], length(P$treated_countries))
DATA_exog           <- F_factors[matching_start_id:matching_end_id,]
colnames(DATA_exog) <- paste("Factor_", P$factor_vars, sep="")
#export factors for a given donor set:
rownames(F_factors) <- Dates_all
write.xlsx2(F_factors, file =  P$factor_output, sheetName="factors", append=F)
# ----------------------------------------------------------------------------------
# Find weights w:
# --------------------------------------------------------------------------------
loss_values <- matrix(NA, nrow=n_test, ncol= length(P$treated_countries))
colnames(loss_values) <- P$treated_countries
for (i in 1: length(P$treated_countries))
{
for(k in 1: n_test)
{
treated_country_id <-  which(P$all_countries == P$treated_countries[i])
Y_matrix           <-  matrix(c(DATA_array_matching[, treated_country_id, ]), ncol=1)
result <- find_w_match_VAR_IRF_black_box(Y_matrix, X_matrix_matching, DATA_donor_matching, F_factors[matching_start_id:matching_end_id,], DATA_exog, P)
W_match_array[,i,k]  <- result$W_i
loss_values[k,i]     <- result$loss_value
}
}
# ----------------------------------------------------------------------------------
# export the IFR data
file_name  <- paste(P$Base_Dir, "Data/temporary storage/stability_test_results.Rdata",sep="")
save(list = c("W_match_array", "loss_values"), file = file_name)
load("C:/Darbas/To be or not to be (base)/Data/temporary storage/stability_test_results.Rdata")
View(loss_values)
W_match_array[,1,]
plot(W_match_array[,1,])
matplot(W_match_array[,1,])
matplot(W_match_array[,2,])
matplot(W_match_array[,3,])
matplot(W_match_array[,4,])
matplot(W_match_array[,5,])
matplot(W_match_array[,6,])
matplot(W_match_array[,7,])
matplot(W_match_array[,8,])
rm(list = ls())   # iðtriname visus kintamuosius
packages <- c("xlsx","optimx", "kernlab", "quadprog", "pracma", "matrixcalc", "plm", "vars")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())))
}
for(i in 1: length(packages))
{
string_to_eval <- paste("library(", packages[i],")", sep="")
eval(parse(text= string_to_eval))
}
P               <- list()
#-------------------------------------------------------
P$Base_Dir      <- "C:/Darbas/To be or not to be (base)/"
#-------------------------------------------------------
P$data_dir       <- paste(P$Base_Dir, "Data/",sep="")
P$result_file    <- paste(P$Base_Dir, "SC_weights.xls",sep="")
P$factor_output  <- paste(P$Base_Dir, "donor_averages.xls",sep="")
source(paste(P$Base_Dir, "R files/supplementary R functions/define_few_general_functions.r", sep=""))
sourceDir(paste(P$Base_Dir, "R files/supplementary R functions/", sep=""))
P$var_data_file  <- paste( P$data_dir, "Variable Data (stationary).xls",sep="")
P$matching_start_date <- "1979Q3"
P$matching_end_date   <- "1998Q3"
P$lambda_window_size <- 20
P$data_scaling  <- "sd_weighting"    # How should we adress potential issues due to variables having different scales?
# "normalise"           -   divide all the data by their sd in the matching period
# "sd_weighting"        - weight errors a la GLS using sd weights for variables in the matching period (only targeted country's sd are used!)
# "no_transformation"   - do nothing
P$data_scaling_for_lambda  <- T
P$use_lambda_weights       <- F
P$w_method           <- "lsqlincon"
P$use_intercep_for_w <- T
# parameters for VAR IRF matching:
P$use_exog_data      <- T
P$stop_when_w_norm_less   <- 10^-5  # optimisation stops when change in w norm less than
P$max_opt_iterations      <- 100
P$irf_horizon <- 12
P$minimum_lag_in_VAR <- 3
P$max_lag_in_VAR     <- 4
P$optim_function <-"constrOptim"
#  P$optim_function <- "optimx"
P$var_names           <- c("y", "Dp", "r", "ep")
P$var_names_long      <- c("GDP", "Inflation", "Interest rate", "Exchange rate")
P$factor_vars         <-  c("y", "Dp")
P$factor_vars_long    <- c("GDP", "Inflation")
P$graph_y_labs <- c("q-o-q change (%)", "Quarterly inflation (%)", "q-o-q change (p.p.)", "q-o-q change (%)")
P$treated_countries      <- c("austria", "bel", "fin", "france", "germ", "italy", "neth", "spain")
P$treated_countries_long <- c("Austria",	"Belgium", "Finland", "France",	"Germany", "Italy", "Netherlands", "Spain")
#  P$donor_countries <- c("arg", "austlia", "bra", "can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
#  P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "dnk", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
#  P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile", "Denmark" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
# Donor set case 2 (without DNK, SWE, UK, Peru, Brazil, Argentina, Australia)
P$donor_countries      <- c("can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "phlp", "safrc", "sarbia", "sing", "switz", "thai", "turk", "usa")
P$donor_countries_long <- c("Canada",	"China",	"Chile","India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Switzerland",	"Thailand",	"Turkey",	"USA")
# Donor set case 2 (without DNK, SWE, UK, Australia, Peru, Brazil, Argentina)
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
#   P$donor_countries      <- c("can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "phlp", "safrc", "sarbia", "sing", "switz", "thai", "turk", "usa")
#   P$donor_countries_long <- c("Canada",	"China",	"Chile","India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Switzerland",	"Thailand",	"Turkey",	"USA")
B_mat <- matrix(NA, length(P$var_names), length(P$var_names))
B_mat[upper.tri(B_mat)] <- 0      # function upper.tri not recognized if put in the function extract_shocks_and_irfs??
P$B_mat <- B_mat
#  P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
# P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
n_test = 10
W_match_array    <- array(NA, dim=c(length(P$donor_countries), length(P$treated_countries), n_test))
intercept_matrix  <- matrix(NA, length(P$var_names), length(P$treated_countries))
R_squared         <- matrix(NA, 1, length(P$treated_countries))
# import data (only for dimension defining purposes):
DATA         <- read.xlsx2(P$var_data_file, sheetName = P$var_names[1], header = T)
Dates_all    <- as.character(DATA[,1])
P$data_start <- as.numeric(unlist(strsplit( Dates_all[1], split="Q")))
DATA         <- DATA[,-1]
P$all_countries <- colnames(DATA)
DATA_array <- array(NA, dim= c(dim(DATA), length(P$var_names)))
for(i in 1:length(P$var_names))
{
DATA <- read.xlsx2(P$var_data_file, sheetName = P$var_names[i], header = T)
DATA <- apply(DATA[,-1], 2, as.numeric)
DATA_array[,,i] <- DATA
}
matching_start_id <- which(Dates_all ==P$matching_start_date)
matching_end_id   <- which(Dates_all ==P$matching_end_date)
result <- prepare_arrays(DATA_array, matching_start_id, matching_end_id, P)
DATA_donor          <- result$DATA_donor
DATA_donor_matching <- result$DATA_donor_matching
DATA_array_matching <- result$DATA_array_matching
X_matrix           <- apply(DATA_donor, 2, c)
X_matrix_matching  <- apply(DATA_donor_matching, 2, c)
if (P$use_intercep_for_w)
{
dummies_for_intercept          <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor)[1],1))
dummies_for_intercept_matching <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor_matching)[1],1))
X_matrix                   <- cbind(dummies_for_intercept, X_matrix)
X_matrix_matching          <- cbind(dummies_for_intercept_matching, X_matrix_matching)
}
F_factors          <- return_factors(DATA_donor, P)
F_matrix           <- regression_matrix_for_F(F_factors, P)
F_matrix_matching  <- regression_matrix_for_F(F_factors[matching_start_id:matching_end_id,], P)
F_coeff_matrix <-  matrix(NA, dim(F_matrix)[2], length(P$treated_countries))
DATA_exog           <- F_factors[matching_start_id:matching_end_id,]
colnames(DATA_exog) <- paste("Factor_", P$factor_vars, sep="")
#export factors for a given donor set:
rownames(F_factors) <- Dates_all
write.xlsx2(F_factors, file =  P$factor_output, sheetName="factors", append=F)
# ----------------------------------------------------------------------------------
# Find weights w:
# --------------------------------------------------------------------------------
loss_values <- matrix(NA, nrow=n_test, ncol= length(P$treated_countries))
colnames(loss_values) <- P$treated_countries
for (i in 1: length(P$treated_countries))
{
for(k in 1: n_test)
{
treated_country_id <-  which(P$all_countries == P$treated_countries[i])
Y_matrix           <-  matrix(c(DATA_array_matching[, treated_country_id, ]), ncol=1)
result <- find_w_match_VAR_IRF_black_box(Y_matrix, X_matrix_matching, DATA_donor_matching, F_factors[matching_start_id:matching_end_id,], DATA_exog, P)
W_match_array[,i,k]  <- result$W_i
loss_values[k,i]     <- result$loss_value
}
}
rm(list = ls())   # iðtriname visus kintamuosius
packages <- c("xlsx","optimx", "kernlab", "quadprog", "pracma", "matrixcalc", "plm", "vars")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())))
}
for(i in 1: length(packages))
{
string_to_eval <- paste("library(", packages[i],")", sep="")
eval(parse(text= string_to_eval))
}
P               <- list()
#-------------------------------------------------------
P$Base_Dir      <- "C:/Darbas/To be or not to be (base)/"
#-------------------------------------------------------
P$data_dir       <- paste(P$Base_Dir, "Data/",sep="")
P$result_file    <- paste(P$Base_Dir, "SC_weights.xls",sep="")
P$factor_output  <- paste(P$Base_Dir, "donor_averages.xls",sep="")
source(paste(P$Base_Dir, "R files/supplementary R functions/define_few_general_functions.r", sep=""))
sourceDir(paste(P$Base_Dir, "R files/supplementary R functions/", sep=""))
P$var_data_file  <- paste( P$data_dir, "Variable Data (stationary).xls",sep="")
P$matching_start_date <- "1979Q3"
P$matching_end_date   <- "1998Q3"
P$lambda_window_size <- 20
P$data_scaling  <- "sd_weighting"    # How should we adress potential issues due to variables having different scales?
# "normalise"           -   divide all the data by their sd in the matching period
# "sd_weighting"        - weight errors a la GLS using sd weights for variables in the matching period (only targeted country's sd are used!)
# "no_transformation"   - do nothing
P$data_scaling_for_lambda  <- T
P$use_lambda_weights       <- F
P$w_method           <- "lsqlincon"
P$use_intercep_for_w <- T
# parameters for VAR IRF matching:
P$use_exog_data      <- T
P$stop_when_w_norm_less   <- 10^-5  # optimisation stops when change in w norm less than
P$max_opt_iterations      <- 100
P$irf_horizon <- 12
P$minimum_lag_in_VAR <- 3
P$max_lag_in_VAR     <- 4
P$optim_function <-"constrOptim"
#  P$optim_function <- "optimx"
P$var_names           <- c("y", "Dp", "r", "ep")
P$var_names_long      <- c("GDP", "Inflation", "Interest rate", "Exchange rate")
P$factor_vars         <-  c("y", "Dp")
P$factor_vars_long    <- c("GDP", "Inflation")
P$graph_y_labs <- c("q-o-q change (%)", "Quarterly inflation (%)", "q-o-q change (p.p.)", "q-o-q change (%)")
P$treated_countries      <- c("austria", "bel", "fin", "france", "germ", "italy", "neth", "spain")
P$treated_countries_long <- c("Austria",	"Belgium", "Finland", "France",	"Germany", "Italy", "Netherlands", "Spain")
#  P$donor_countries <- c("arg", "austlia", "bra", "can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
#  P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "dnk", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
#  P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile", "Denmark" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
# Donor set case 2 (without DNK, SWE, UK, Peru, Brazil, Argentina, Australia)
P$donor_countries      <- c("can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "phlp", "safrc", "sarbia", "sing", "switz", "thai", "turk", "usa")
P$donor_countries_long <- c("Canada",	"China",	"Chile","India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Switzerland",	"Thailand",	"Turkey",	"USA")
# Donor set case 2 (without DNK, SWE, UK, Australia, Peru, Brazil, Argentina)
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
#   P$donor_countries      <- c("can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "phlp", "safrc", "sarbia", "sing", "switz", "thai", "turk", "usa")
#   P$donor_countries_long <- c("Canada",	"China",	"Chile","India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Switzerland",	"Thailand",	"Turkey",	"USA")
B_mat <- matrix(NA, length(P$var_names), length(P$var_names))
B_mat[upper.tri(B_mat)] <- 0      # function upper.tri not recognized if put in the function extract_shocks_and_irfs??
P$B_mat <- B_mat
#  P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
# P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
n_test = 10
W_match_array    <- array(NA, dim=c(length(P$donor_countries), length(P$treated_countries), n_test))
intercept_matrix  <- matrix(NA, length(P$var_names), length(P$treated_countries))
R_squared         <- matrix(NA, 1, length(P$treated_countries))
# import data (only for dimension defining purposes):
DATA         <- read.xlsx2(P$var_data_file, sheetName = P$var_names[1], header = T)
Dates_all    <- as.character(DATA[,1])
P$data_start <- as.numeric(unlist(strsplit( Dates_all[1], split="Q")))
DATA         <- DATA[,-1]
P$all_countries <- colnames(DATA)
DATA_array <- array(NA, dim= c(dim(DATA), length(P$var_names)))
for(i in 1:length(P$var_names))
{
DATA <- read.xlsx2(P$var_data_file, sheetName = P$var_names[i], header = T)
DATA <- apply(DATA[,-1], 2, as.numeric)
DATA_array[,,i] <- DATA
}
matching_start_id <- which(Dates_all ==P$matching_start_date)
matching_end_id   <- which(Dates_all ==P$matching_end_date)
result <- prepare_arrays(DATA_array, matching_start_id, matching_end_id, P)
DATA_donor          <- result$DATA_donor
DATA_donor_matching <- result$DATA_donor_matching
DATA_array_matching <- result$DATA_array_matching
X_matrix           <- apply(DATA_donor, 2, c)
X_matrix_matching  <- apply(DATA_donor_matching, 2, c)
if (P$use_intercep_for_w)
{
dummies_for_intercept          <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor)[1],1))
dummies_for_intercept_matching <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor_matching)[1],1))
X_matrix                   <- cbind(dummies_for_intercept, X_matrix)
X_matrix_matching          <- cbind(dummies_for_intercept_matching, X_matrix_matching)
}
F_factors          <- return_factors(DATA_donor, P)
F_matrix           <- regression_matrix_for_F(F_factors, P)
F_matrix_matching  <- regression_matrix_for_F(F_factors[matching_start_id:matching_end_id,], P)
F_coeff_matrix <-  matrix(NA, dim(F_matrix)[2], length(P$treated_countries))
DATA_exog           <- F_factors[matching_start_id:matching_end_id,]
colnames(DATA_exog) <- paste("Factor_", P$factor_vars, sep="")
#export factors for a given donor set:
rownames(F_factors) <- Dates_all
write.xlsx2(F_factors, file =  P$factor_output, sheetName="factors", append=F)
# ----------------------------------------------------------------------------------
# Find weights w:
# --------------------------------------------------------------------------------
loss_values <- matrix(NA, nrow=n_test, ncol= length(P$treated_countries))
colnames(loss_values) <- P$treated_countries
for (i in 1: length(P$treated_countries))
{
for(k in 1: n_test)
{
treated_country_id <-  which(P$all_countries == P$treated_countries[i])
Y_matrix           <-  matrix(c(DATA_array_matching[, treated_country_id, ]), ncol=1)
result <- find_w_match_VAR_IRF_black_box(Y_matrix, X_matrix_matching, DATA_donor_matching, F_factors[matching_start_id:matching_end_id,], DATA_exog, P)
W_match_array[,i,k]  <- result$W_i
loss_values[k,i]     <- result$loss_value
}
}
# ----------------------------------------------------------------------------------
# export the IFR data
file_name  <- paste(P$Base_Dir, "Data/temporary storage/stability_test_results.Rdata",sep="")
save(list = c("W_match_array", "loss_values"), file = file_name)
load("C:/Darbas/To be or not to be (base)/Data/temporary storage/stability_test_results.Rdata")
View(loss_values)
matplot(W_match_array)
matplot(W_match_array[,1,])
matplot(W_match_array[c(1,4,5),1,])
matplot(W_match_array[,1,])
matplot(W_match_array[,2,])
matplot(W_match_array[,3,])
matplot(W_match_array[,4,])
matplot(W_match_array[,5,])
matplot(W_match_array[,6,])
plot(W_match_array[2,6,]-W_match_array[9,6,])
plot(W_match_array[2,6,])
plot(W_match_array[2,9,])
plot(W_match_array[2,6,])
plot(W_match_array[9,6,])
rm(list = ls())   # iðtriname visus kintamuosius
packages <- c("xlsx","optimx", "kernlab", "quadprog", "pracma", "matrixcalc", "plm", "vars")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())))
}
for(i in 1: length(packages))
{
string_to_eval <- paste("library(", packages[i],")", sep="")
eval(parse(text= string_to_eval))
}
P               <- list()
#-------------------------------------------------------
P$Base_Dir      <- "C:/Darbas/To be or not to be (base)/"
#-------------------------------------------------------
P$data_dir       <- paste(P$Base_Dir, "Data/",sep="")
P$result_file    <- paste(P$Base_Dir, "SC_weights.xls",sep="")
P$factor_output  <- paste(P$Base_Dir, "donor_averages.xls",sep="")
source(paste(P$Base_Dir, "R files/supplementary R functions/define_few_general_functions.r", sep=""))
sourceDir(paste(P$Base_Dir, "R files/supplementary R functions/", sep=""))
P$var_data_file  <- paste( P$data_dir, "Variable Data (stationary).xls",sep="")
P$matching_start_date <- "1979Q3"
P$matching_end_date   <- "1998Q3"
P$lambda_window_size <- 20
P$data_scaling  <- "sd_weighting"    # How should we adress potential issues due to variables having different scales?
# "normalise"           -   divide all the data by their sd in the matching period
# "sd_weighting"        - weight errors a la GLS using sd weights for variables in the matching period (only targeted country's sd are used!)
# "no_transformation"   - do nothing
P$data_scaling_for_lambda  <- T
P$use_lambda_weights       <- F
P$w_method           <- "lsqlincon"
P$use_intercep_for_w <- T
# parameters for VAR IRF matching:
P$use_exog_data      <- T
P$stop_when_w_norm_less   <- 10^-5  # optimisation stops when change in w norm less than
P$max_opt_iterations      <- 100
P$irf_horizon <- 12
P$minimum_lag_in_VAR <- 3
P$max_lag_in_VAR     <- 4
P$optim_function <-"constrOptim"
#  P$optim_function <- "optimx"
P$var_names           <- c("y", "Dp", "r", "ep")
P$var_names_long      <- c("GDP", "Inflation", "Interest rate", "Exchange rate")
P$factor_vars         <-  c("y", "Dp")
P$factor_vars_long    <- c("GDP", "Inflation")
P$graph_y_labs <- c("q-o-q change (%)", "Quarterly inflation (%)", "q-o-q change (p.p.)", "q-o-q change (%)")
P$treated_countries      <- c("austria", "bel", "fin", "france", "germ", "italy", "neth", "spain")
P$treated_countries_long <- c("Austria",	"Belgium", "Finland", "France",	"Germany", "Italy", "Netherlands", "Spain")
#  P$donor_countries <- c("arg", "austlia", "bra", "can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "dnk", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile", "Denmark" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
# Donor set case 2 (without DNK, SWE, UK, Peru, Brazil, Argentina, Australia)
#   P$donor_countries      <- c("can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "phlp", "safrc", "sarbia", "sing", "switz", "thai", "turk", "usa")
#   P$donor_countries_long <- c("Canada",	"China",	"Chile","India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Switzerland",	"Thailand",	"Turkey",	"USA")
# Donor set case 2 (without DNK, SWE, UK, Australia, Peru, Brazil, Argentina)
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
#   P$donor_countries      <- c("can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "phlp", "safrc", "sarbia", "sing", "switz", "thai", "turk", "usa")
#   P$donor_countries_long <- c("Canada",	"China",	"Chile","India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Switzerland",	"Thailand",	"Turkey",	"USA")
B_mat <- matrix(NA, length(P$var_names), length(P$var_names))
B_mat[upper.tri(B_mat)] <- 0      # function upper.tri not recognized if put in the function extract_shocks_and_irfs??
P$B_mat <- B_mat
#  P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
# P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
n_test = 10
W_match_array    <- array(NA, dim=c(length(P$donor_countries), length(P$treated_countries), n_test))
intercept_matrix  <- matrix(NA, length(P$var_names), length(P$treated_countries))
R_squared         <- matrix(NA, 1, length(P$treated_countries))
# import data (only for dimension defining purposes):
DATA         <- read.xlsx2(P$var_data_file, sheetName = P$var_names[1], header = T)
Dates_all    <- as.character(DATA[,1])
P$data_start <- as.numeric(unlist(strsplit( Dates_all[1], split="Q")))
DATA         <- DATA[,-1]
P$all_countries <- colnames(DATA)
DATA_array <- array(NA, dim= c(dim(DATA), length(P$var_names)))
for(i in 1:length(P$var_names))
{
DATA <- read.xlsx2(P$var_data_file, sheetName = P$var_names[i], header = T)
DATA <- apply(DATA[,-1], 2, as.numeric)
DATA_array[,,i] <- DATA
}
matching_start_id <- which(Dates_all ==P$matching_start_date)
matching_end_id   <- which(Dates_all ==P$matching_end_date)
result <- prepare_arrays(DATA_array, matching_start_id, matching_end_id, P)
DATA_donor          <- result$DATA_donor
DATA_donor_matching <- result$DATA_donor_matching
DATA_array_matching <- result$DATA_array_matching
X_matrix           <- apply(DATA_donor, 2, c)
X_matrix_matching  <- apply(DATA_donor_matching, 2, c)
if (P$use_intercep_for_w)
{
dummies_for_intercept          <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor)[1],1))
dummies_for_intercept_matching <- kronecker(diag(length(P$var_names)), matrix(1, dim(DATA_donor_matching)[1],1))
X_matrix                   <- cbind(dummies_for_intercept, X_matrix)
X_matrix_matching          <- cbind(dummies_for_intercept_matching, X_matrix_matching)
}
F_factors          <- return_factors(DATA_donor, P)
F_matrix           <- regression_matrix_for_F(F_factors, P)
F_matrix_matching  <- regression_matrix_for_F(F_factors[matching_start_id:matching_end_id,], P)
F_coeff_matrix <-  matrix(NA, dim(F_matrix)[2], length(P$treated_countries))
DATA_exog           <- F_factors[matching_start_id:matching_end_id,]
colnames(DATA_exog) <- paste("Factor_", P$factor_vars, sep="")
#export factors for a given donor set:
rownames(F_factors) <- Dates_all
write.xlsx2(F_factors, file =  P$factor_output, sheetName="factors", append=F)
# ----------------------------------------------------------------------------------
# Find weights w:
# --------------------------------------------------------------------------------
loss_values <- matrix(NA, nrow=n_test, ncol= length(P$treated_countries))
colnames(loss_values) <- P$treated_countries
for (i in 1: length(P$treated_countries))
{
for(k in 1: n_test)
{
treated_country_id <-  which(P$all_countries == P$treated_countries[i])
Y_matrix           <-  matrix(c(DATA_array_matching[, treated_country_id, ]), ncol=1)
result <- find_w_match_VAR_IRF_black_box(Y_matrix, X_matrix_matching, DATA_donor_matching, F_factors[matching_start_id:matching_end_id,], DATA_exog, P)
W_match_array[,i,k]  <- result$W_i
loss_values[k,i]     <- result$loss_value
}
}
# ----------------------------------------------------------------------------------
# export the IFR data
file_name  <- paste(P$Base_Dir, "Data/temporary storage/stability_test_results.Rdata",sep="")
save(list = c("W_match_array", "loss_values"), file = file_name)
rm(list = ls())   # iðtriname visus kintamuosius
packages <- c("xlsx", "xtable")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())))
}
for(i in 1: length(packages))
{
string_to_eval <- paste("library(", packages[i],")", sep="")
eval(parse(text= string_to_eval))
}
P               <- list()
#-------------------------------------------------------
P$Base_Dir      <- "C:/Darbas/Replication of papers/Dancing Alone or Together. The Dynamic Effects of Independent and Common Labour Market Effects/"
#-------------------------------------------------------
P$data_dir     <- paste(P$Base_Dir, "Data/",sep="")
source(paste(P$Base_Dir, "R files/supplementary R functions/define_few_general_functions.r", sep=""))
sourceDir(paste(P$Base_Dir, "R files/supplementary R functions/", sep=""))
P$var_data_file  <- paste( P$data_dir, "Variable Data (stationary).xls",sep="")
P$summary_stats_start <- "1979Q3"
P$summary_stats_end   <- "2016Q4"
P$var_names           <- c("y", "Dp", "r", "ep")
P$var_names_long      <- c("GDP", "Inflation", "Interest rate", "Exchange rate")
P$treated_countries      <- c("austria", "bel", "fin", "france", "germ", "italy", "neth", "spain")
P$treated_countries_long <- c("Austria",	"Belgium", "Finland", "France",	"Germany", "Italy", "Netherlands", "Spain")
# we drop Saudi Arabia due to missing interest rate data (IFS has data only from 1999)
P$donor_countries      <- c("arg", "austlia", "bra", "can", "china", "chl", "dnk", "india", "indns", "japan", "kor", "mal", "mex", "nor", "nzld", "per", "phlp", "safrc", "sarbia", "sing", "swe", "switz", "thai", "turk", "uk", "usa")
P$donor_countries_long <- c("Argentina",	"Australia", "Brazil",	"Canada",	"China",	"Chile", "Denmark" ,"India", "Indonesia",	"Japan",	"Korea",	"Malaysia",	"Mexico",	"Norway",	"New Zealand",	"Peru",	"Philippines",	"South Africa",	"Saudi Arabia", "Singapore", "Sweden", "Switzerland",	"Thailand",	"Turkey",	"UK",	"USA")
SUMMARY_stats <- matrix(NA, nrow = length(P$treated_countries ) + length(P$donor_countries), ncol = length(P$var_names)*2)
# Import all the data
# import data (only for dimension defining purposes):
DATA         <- read.xlsx2(P$var_data_file, sheetName = P$var_names[1], header = T)
Dates_all    <- as.character(DATA[,1])
P$data_start <- as.numeric(unlist(strsplit( Dates_all[1], split="Q")))
DATA         <- DATA[,-1]
all_countries_array <- colnames(DATA)
DATA_array <- array(NA, dim= c(dim(DATA), length(P$var_names)))
for(i in 1:length(P$var_names))
{
DATA <- read.xlsx2(P$var_data_file, sheetName = P$var_names[i], header = T)
DATA <- apply(DATA[,-1], 2, as.numeric)
DATA_array[,,i] <- DATA
}
all_countries_table       <- c(P$treated_countries, P$donor_countries)
all_countries_table_long  <- c(P$treated_countries_long, P$donor_countries_long)
cols_for_mean <- 1:length(P$var_names)*2-1
cols_for_sd   <- 1:length(P$var_names)*2
not_r_cols <- which(P$var_names!="r")
for(i in 1: length(all_countries_table))
{
country_id_in_array <- which(all_countries_table[i]==all_countries_array)
country_i_data               <- DATA_array[,country_id_in_array,]
country_i_data[, not_r_cols] <- 100*country_i_data[, not_r_cols]
SUMMARY_stats[i,cols_for_mean] <- apply( country_i_data, 2, mean)
SUMMARY_stats[i,cols_for_sd]   <- apply( country_i_data, 2, sd)
}
rownames(SUMMARY_stats) <- all_countries_table_long
colnames(SUMMARY_stats) <- rep( c("mean", "sd"), length(P$var_names))
# first_row <- rep("", length( colnames(SUMMARY_stats)))
#first_row[cols_for_mean] <- P$var_names_long
#SUMMARY_stats <- rbind(first_row, SUMMARY_stats)
# output_file <- paste(P$Base_Dir,"summary_stats.tex", sep="")
xtable(SUMMARY_stats, digits=3)
output_file <- paste(P$Base_Dir,"summary_stats.tex", sep="")
xtable(SUMMARY_stats, digits=3)
print(xtable(SUMMARY_stats, digits=2), type = "latex", file = output_file)
